;;########################################################################
;; mmrmob3.lsp
;; options dialog (non-unix) for multivariate multiple regression object
;; Copyright (c) 1991-97 by Forrest W. Young
;;########################################################################


(defmeth mmr-model-object-proto :options ()
"Args: none
Constructs and displays the options dialog window for regression models.
Returns nil or a four element list.  Returns nil when dialog canceled or when no response or predictor variables selected, returns four element list otherwise.  The first element of the list is a list of response variable indices.  The second element is a list of predictor variable indices. The third element is the index of the weight variable, or nil for unweighted analysis.  The fourth element is T for intercept models, nil for non-intercept models."
  (when (not (send self :dialog))
        (send self :iv ($position (send self :predictors)
                                  (send self :variables)))
        (send self :dv ($position (send self :responses)
                                  (send self :variables))))
  (when (send self :dialog)
  (let* ((mob self)
         (box-text-item (send text-item-proto :new 
                              "Multivariate Multiple Regression"))
         (select-text (send text-item-proto :new "Select Regression Variables:"))
         (select-toggle (send choice-item-proto :new (list
                              "Response  Variables"
                              "Predictor Variables") 
                              :value 0))
         (redun-title (send text-item-proto :new 
                           (format nil "Redundancy Analysis~%(optional):")))
         (use-text (send text-item-proto :new "Use"))
         (redun (send edit-text-item-proto :new "0"))
         (redun-text (send text-item-proto :new 
                           (format nil "Redundancy~%Variates")))
         (var-text-item (send text-item-proto :new "Selectable Variables"))
         (rsp-text-item (send text-item-proto :new "Selected Responses"))
         (prd-text-item (send text-item-proto :new "Selected Predictors"))
         
         (var-list (send self :variables))
         (num-box-vars (length var-list))
         (rsp-list (repeat " " num-box-vars))
         (prd-list (repeat " " num-box-vars))
         (rsp-nums nil)
         (prd-nums nil)
         (weight-num nil)
         (hi (* 13 (min 5 num-box-vars)))
         (rsp-list-item (send list-item-proto :new rsp-list :size (list 100 hi)))
         (prd-list-item (send list-item-proto :new prd-list :size (list 100 hi)))
         (var-list-item (send list-item-proto :new var-list :size (list 100 hi)
                              :action #'(lambda () (move-vars &optional dc))))
         (ok        (send modal-button-proto :new "OK"))
         (cancel    (send modal-button-proto :new "Cancel"))
         (reg-dialog (send modal-dialog-proto :new
                           (list box-text-item
                                 (list (list select-text select-toggle)
                                       (list redun-title (list use-text redun redun-text)))
                                 (list (list var-text-item var-list-item)
                                       (list rsp-text-item rsp-list-item)
                                       (list prd-text-item prd-list-item))
                                 (list ok cancel))
                           :default-button ok)))

    (defmeth ok :do-action ()
      (let ((dialog (send ok :dialog))
            )
        (send mob :intercept t)
        (send mob :weights weight-num)
        (send mob :iv prd-nums)
        (send mob :dv rsp-nums)
        (send mob :redundancy (number-from-string (send redun :text)))
        (cond 
          ((or (> 1 (length prd-nums))
               (> 1 (length rsp-nums)))
           (error-message "You must select at least one response and one predictor variable.")
           (send dialog :modal-dialog-return nil))
          (t (send dialog :modal-dialog-return t)))
        ))

    (defmeth cancel :do-action ()
      (let ((dialog (send cancel :dialog)))
        (send dialog :modal-dialog-return nil)))

    (defmeth var-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (s (select (send self :slot-value 'list-data) n))
             (m nil))
        (when (and n (not (equal s " ")))
              (send self :set-text n " ") ;OK
              (when (= 0 (send select-toggle :value))
                    (setf m (position " " 
                               (send rsp-list-item :slot-value  'list-data)
                                      :test 'equal))
                    (send rsp-list-item :set-text m s)
                    (setf rsp-nums (concatenate 'list rsp-nums (list n))))
              (when (= 1 (send select-toggle :value))
                    (setf m (position " " 
                               (send prd-list-item :slot-value  'list-data)
                                      :test 'equal))
                    (send prd-list-item :set-text m s)
                    (setf prd-nums (concatenate 'list prd-nums (list n))))
              (send self :selection nil))))

    (defmeth rsp-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length rsp-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n) 
                    (setf m (select rsp-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i 
                                        (select (send self :slot-value 
                                                      'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send var-list-item :set-text m s)
                    (setf rsp-nums (remove m rsp-nums)))
                    (send self :selection nil)
              )))

    (defmeth prd-list-item :do-action (&optional dbl-clk)
      (let* ((n (send self :selection))
             (L (length prd-nums))
             (s nil)
             (m nil))
        (when n
              (setf s (select (send self :slot-value 'list-data) n))
              (when (> L n)
                    (setf m (select prd-nums n))
                    (when (< n (1- L))
                          (dolist (i (iseq n (- L 2)))
                                  (send self :set-text i 
                                        (select (send self :slot-value
                                                      'list-data) (1+ i)))))
                    (send self :set-text (1- L) " ")
                    (send var-list-item :set-text m s)
                    (setf prd-nums (remove m prd-nums)))
              (send self :selection nil)
              )))

    (if (send reg-dialog :modal-dialog)
        (list rsp-nums prd-nums weight-num t 
              (send redun :text));:value
        nil))))
  
